(** Common histogram hierarchy for the Monitor *)
open Histo


class type group=object
    method name: string
    method get_hists: hist list
    method fill_hists: unit
end

(** this type contains 4 variants of histogram containers:
    1) Hist_list (name,list) -- list of histograms <list> with name <name>
    2) Group g -- where <g> is object of class type group, contained list of
    histograms, intended for automatic filling of histograms through function
    "fill_all"
    3) Matrix_picture (n_rows,n_columns,name, array) -- contains 2d-array of
    histograms <array>, which should have dimensions <n_rows> x <n_columns>
    4) Directory (name,list) -- directory <name> contains list <list> of other
    values ("files") in this directory

    So all this type is ierarhical structure of histogram containers.
    It's intended for direct mapping to GUI structures 
    (e.g. Gtk notebooks and buttons). 
*)

type 'a dir = [
    `Group of group
  | `Hist_list of string * hist list
  | `Matrix_picture of int * int * string * hist array array
  | `Array_picture of int * string * hist array
  | `Directory of string * ('a list)
]

let group_of g = `Group (g :> group)

exception Not_found_histogram of string

let find path dir : hist =
    let fail reason=
        let reason_and_help=reason^
            "\nUsage: Format string: \n"^
            "\t/Detector/.../path/group/histogram name\n"^
            "For example:\n\t/GDA/11x11/5,6\n"^
            "Or:\n\t/BPC/1X/1X/profile_(with gates)"
        in
	raise (Not_found_histogram reason_and_help) 
    in
    let rec next_level current_path (rest_path: string list) directory =
        (match rest_path with
        | [] -> fail "Histogram name is not provided"
        | _::[] -> fail "Group name is not provided"
        | group_name::hist_name::[] -> (match directory with
            | `Directory (_,list) ->
                let g = try List.find (function 
                    | `Group g -> group_name=g#name
                    | `Hist_list (name,_) -> group_name = name
                    | `Matrix_picture (_,_,s,_) -> s=group_name 
                    | `Array_picture (_,s,_) -> s=group_name 
                    | _ -> false
                ) list 
                with Not_found -> 
                    fail ("there is no Group "^group_name^" in "^current_path)
                in
                let get_from l =
                    try List.find (fun h -> (name h) = hist_name) l
                    with Not_found ->
                        fail ("there is no histogram "^hist_name^
                            " in Group "^current_path^group_name)
                in
                (match g with
                | `Group g -> get_from g#get_hists
                | `Hist_list (_,l)-> get_from l
                | `Matrix_picture (nx, ny, _, hist_2arr) -> (
                    let ix=ref 0 and iy=ref 0 in
                    (* delete spaces, e.g. 1, 2 -> 1,2 *)
                    let hist_name'=Str.global_replace (Str.regexp " ") ""
                        hist_name in
                    (try Scanf.sscanf hist_name' "%i,%i" (
                         fun i1 i2 -> ix := i1; iy:= i2);
                    with _ -> fail (Printf.sprintf 
                        "incorrect format of Matrix cell: %s" hist_name')
                    );
                    if nx >= !ix && !ix > 0 && ny >= !iy && !iy > 0
                    then hist_2arr.(!ix-1).(!iy-1)
                    else fail ((Printf.sprintf 
                        "incorrect matrix range %i,%i\n" !ix !iy)^
                        (Printf.sprintf 
                        "should be in range [1:%i],[1:%i]" nx ny))
                    )
                | `Array_picture (nx, _, hist_2arr) -> (
                    let ix=ref 0 in
                    (try Scanf.sscanf hist_name "%i" (
                         fun i1 -> ix := i1);
                    with _ -> fail (Printf.sprintf 
                        "incorrect format of Array cell: %s" hist_name)
                    );
                    if nx >= !ix && !ix > 0 
                    then hist_2arr.(!ix-1)
                    else fail ((Printf.sprintf 
                        "incorrect matrix range %i\n" !ix)^
                        (Printf.sprintf 
                        "should be in range [1:%i]" nx))
                    )
                | _ -> fail "Error: wrong name provided"
                )
            | _ -> fail ("internal error: "^current_path^" is NOT Directory!")
            )
        | current::rest -> 
            (match directory with
            | `Directory (name,list)->
                let dir = try List.find (function 
                    | `Directory (name,list) -> current=name 
                    | _ -> false
                ) list
                with Not_found -> 
                    fail ("there is no directory "^current^" in "^current_path)
                in
                next_level (current_path^current^"/") rest dir 
            | _ ->  fail ("internal error: provided hierarchy is not Directory")
            )
        ) in
    let path_list=Str.split (Str.regexp "/") path in
    let path_list'=List.filter (fun a -> a <> "") path_list in
    next_level "/" path_list' dir

open Glob
let print_shift n = print_string (String.make (3*n) ' ')

let print1 (print_rec:  ?shift:int ->
	     'a ->
             unit) 
    (l: int) dir =
(*  print_endline (string_of_int l);*)
  (match dir with
    `Group g -> 
        print_shift l; print_endline g#name; 
        print_shift  (l+1);
        List.iter (fun h -> print_string (name h); print_string " ") g#get_hists;
        print_newline ()
    | `Directory (name,list) -> 
        print_shift l; print_endline (name^"/"); 
        List.iter (fun d -> print_rec ~shift:(l+1) d) list
    | `Matrix_picture (n_x,n_y,name,_) ->
        print_shift l;
        print_endline name;
        print_shift (l+1);
        Printf.printf "Matrix %d,%d of histograms\n" n_x n_y 
    | `Array_picture (n_x,name,_) ->
        print_shift l;
        print_endline name;
        print_shift (l+1);
        Printf.printf "Array %d of histograms\n" n_x  
    | _ ->
	print_endline "Unknown object "
  )

let rec print ?(shift=0) d = print1 print shift d

let rec fill_all hdir =
    match hdir with
    `Group g -> g#fill_hists 
  | `Directory(name,l) -> List.iter (fun d -> fill_all d ) l
  | _ -> () (** Matrix_picture should be filled via hist group *)

let matrix_of arr name =
    let i = Array.length arr
    and j = Array.length arr.(0) in
    (`Matrix_picture (i,j,name,arr))

let array_of arr name =
    let i = Array.length arr in
    (`Array_picture (i,name,arr))
